home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 401-425 / disk_418 / moduladefs / flashypd.mod < prev    next >
Text File  |  1992-05-06  |  5KB  |  192 lines
  1. (********************************************************************************
  2.  
  3. Name         : Flash.MOD
  4. Version      : 1.0
  5. Purpose      : Modula 2 version of Color Art by Rick Wirch
  6.                With extra touches my the author
  7. Author       : Jonas S Green
  8. Modified     : 3.22.87  JSG
  9.  
  10. ********************************************************************************)
  11.  
  12. MODULE Flash;
  13.  
  14. FROM Breaks     IMPORT DetectBreak,BreakFlags;
  15. FROM Terminal   IMPORT WriteString, WriteLn;
  16. FROM SYSTEM     IMPORT ADDRESS, ADR, BYTE, LONG;
  17. FROM AMIGADos   IMPORT Delay;
  18. FROM Graphic    IMPORT Move,SetAPen,SetBPen,Text,SetRGB4,Draw,SetRast,
  19.                        RectFill;
  20. FROM Intuition  IMPORT OpenScreen,CloseScreen,OpenWindow,CloseWindow,
  21.                        ViewPortAddress,
  22.                        NewWindow,NewScreen,Window,WindowPtr,
  23.                        CLOSEWINDOW,WINDOWCLOSE,ACTIVATE,WINDOWDRAG,
  24.                        WINDOWDEPTH,WINDOWSIZING,BORDERLESS,NOCAREREFRESH,
  25.                        CUSTOMSCREEN,WBSCREEN,HIRES,INTERLACE,BACKDROP;
  26.  
  27. FROM MathLib0   IMPORT SIN,COS;
  28.  
  29.  
  30. CONST RA = 1.5807;
  31.  
  32. PROCEDURE Flash1(rast,x,y:LONGINT;i:REAL);
  33.  
  34. VAR x1,y1 : LONGINT;
  35.     neg : BOOLEAN;
  36.     temp : LONGINT;
  37.  
  38. BEGIN
  39.   y1 := TRUNC(90.0*SIN(RA*i,neg));
  40.   IF neg THEN y1 := -y1 END;
  41.   y1 := y1 + 96D;
  42.   x1 := TRUNC(150.0*COS(i,neg));
  43.   IF neg THEN x1 := -x1 END;
  44.   x1 := x1 + 160D;
  45.  
  46.   IF x1<x THEN
  47.     temp := x1;
  48.     x1 := x;
  49.     x := temp;
  50.   END;
  51.  
  52.   IF y1<y THEN
  53.      temp := y1;
  54.      y1 := y;
  55.      y := temp;
  56.   END;
  57.  
  58.   RectFill(rast,x,y,x1,y1);
  59.  
  60. END Flash1;
  61.  
  62.  
  63. PROCEDURE Flash2(rast,x,y : LONGINT);
  64.  
  65. BEGIN
  66.   RectFill(rast,0,0,x,y);
  67. END Flash2;
  68.  
  69. PROCEDURE Flash3(rast: LONGINT;x,y: LONGINT;VAR xo,yo : LONGINT);
  70.  
  71. BEGIN
  72.   Move(rast,160D,99D);
  73.   Draw(rast,xo,yo);
  74.   Draw(rast,x,y);
  75.   Draw(rast,160D,99D);
  76.   xo := x;  yo := y;
  77. END Flash3;
  78.  
  79.  
  80. VAR
  81.     nw: NewWindow;
  82.     ns: NewScreen;
  83.     w: WindowPtr;
  84.     s: LONGINT;
  85.     st, wt: ARRAY [0..31] OF CHAR;
  86.     fg,bg,rast : LONGINT;
  87.     p: LONGINT;
  88.     xo,yo,x,y : LONGINT;
  89.     Times : CARDINAL;
  90.     vpa : ADDRESS;
  91.       i : REAL;
  92.     neg : BOOLEAN;
  93.     continue : BOOLEAN;
  94.  
  95. BEGIN
  96.   WriteString("Flashy Graphics"); WriteLn;
  97.   WriteString("===============");
  98.   WriteLn; WriteLn;
  99.   WriteString("By Jonas S. Green"); WriteLn;
  100.   WriteString("Based on Color Art by Rich Wirch"); WriteLn;
  101.   WriteString("Hit Cntrl-C to Exit"); WriteLn;
  102.   Delay(30);
  103.     st:='Flashy';
  104.     WITH ns DO
  105.       leftEdge:=0;
  106.       topEdge:=0;
  107.       width:=320;
  108.       height:=200 (* 400 *);
  109.       depth:=4;
  110.       detailPen:=BYTE(0);
  111.       blockPen:=BYTE(0);
  112.       viewModes:=0D;
  113.       type:=CUSTOMSCREEN;
  114.       font:=0D;
  115.       title:=ADR(st);
  116.       gadget:=0D;
  117.       bitMap:=0D
  118.     END;
  119.     s:=OpenScreen(ns);
  120.     IF s=0D THEN
  121.       WriteString('Error: screen not opend'); WriteLn;
  122.       RETURN
  123.     END;
  124.     wt:='Flashy Window';
  125.     WITH nw DO
  126.       leftEdge:=0;
  127.       topEdge:=0;
  128.       width:=320;
  129.       height:=200;
  130.       detailPen:=BYTE(0);
  131.       blockPen:=BYTE(0);
  132.       IDCMPFlags:=CLOSEWINDOW;
  133.       flags:=WINDOWCLOSE  + NOCAREREFRESH + BORDERLESS +
  134.              BACKDROP;
  135.  
  136.       firstGadget:=0D;
  137.       checkMark:=0D;
  138.       title:=ADR(wt);
  139.       screen:=ADDRESS(s);
  140.       bitMap:=0D;
  141.       minWidth:=320;
  142.       minHeight:=200;
  143.       maxWidth:=320;
  144.       maxHeight:=200;
  145.       type:=CUSTOMSCREEN 
  146.     END; (* declaring first window *)
  147.  
  148.     w:=OpenWindow(nw);
  149.     IF LONGINT(w)=0D THEN
  150.       WriteString(' Error: OpenWindow Failed');
  151.     ELSE
  152.       rast := LONGINT(w^.Rport);
  153.       vpa := ViewPortAddress(w);
  154.       SetRGB4(vpa,0D,0D,1D,1D);
  155.       SetRGB4(vpa,1D,0D,1D,1D);
  156.       SetRGB4(vpa,2D,0D,1D,1D);
  157.       fg := 0D;
  158.       LOOP
  159.       FOR Times := 1 TO 3 DO
  160.          SetRast(rast,0D);
  161.          xo := 160D;
  162.          yo := 99D;
  163.          i := 0.0;
  164.          WHILE i<=18.0  DO
  165.             x := TRUNC(150.0 * SIN(i,neg));
  166.             IF neg THEN x := -x END;
  167.             x := x + 160D;
  168.             y := TRUNC(90.0*COS(RA*i,neg));
  169.             IF neg THEN y := -y END;
  170.             y := y + 96D;
  171.             IF Times = 1 THEN Flash1(rast,x,y,i) END;
  172.             IF Times = 2 THEN Flash2(rast,x,y) END;
  173.             IF Times = 3 THEN Flash3(rast,x,y,xo,yo) END;
  174.             IF DetectBreak(breakC) THEN EXIT END;
  175.             fg := (fg + 1D) MOD 13D;
  176.             p := 3D;
  177.             WHILE p <= 15D DO
  178.                bg := ((p+fg) MOD 12D) + 3D;
  179.                SetRGB4(vpa,bg,5D,p,p);
  180.                p := p + 1D;
  181.             END; (* WHILE *)
  182.             bg := fg + 3D;
  183.             SetAPen(rast,bg);
  184.             i := i + 0.05;
  185.           END; (* WHILE i *)
  186.       END;  (* FOR Times *)
  187.       END; (* LOOP *)
  188.     CloseWindow(w);
  189.     CloseScreen(s);
  190.   END;
  191. END Flash.
  192.